home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / misc / dspice0s / sstf.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-11-22  |  12.7 KB  |  402 lines
  1. /* sstf.f -- translated by f2c (version of 3 February 1990  3:36:42).
  2.    You must link the resulting object file with the libraries:
  3.     -lF77 -lI77 -lm -lc   (in that order)
  4. */
  5.  
  6. #include "f2c.h"
  7.  
  8. /* Common Block Declarations */
  9.  
  10. struct {
  11.     integer ielmnt, isbckt, nsbckt, iunsat, nunsat, itemps, numtem, isens, 
  12.         nsens, ifour, nfour, ifield, icode, idelim, icolum, insize, 
  13.         junode, lsbkpt, numbkp, iorder, jmnode, iur, iuc, ilc, ilr, 
  14.         numoff, isr, nmoffc, iseq, iseq1, neqn, nodevs, ndiag, iswap, 
  15.         iequa, macins, lvnim1, lx0, lvn, lynl, lyu, lyl, lx1, lx2, lx3, 
  16.         lx4, lx5, lx6, lx7, ld0, ld1, ltd, imynl, imvn, lcvn, nsnod, 
  17.         nsmat, nsval, icnod, icmat, icval, loutpt, lpol, lzer, irswpf, 
  18.         irswpr, icswpf, icswpr, irpt, jcpt, irowno, jcolno, nttbr, nttar, 
  19.         lvntmp;
  20. } tabinf_;
  21.  
  22. #define tabinf_1 tabinf_
  23.  
  24. struct {
  25.     integer locate[50], jelcnt[50], nunods, ncnods, numnod, nstop, nut, nlt, 
  26.         nxtrm, ndist, ntlin, ibr, numvs, numalt, numcyc;
  27. } cirdat_;
  28.  
  29. #define cirdat_1 cirdat_
  30.  
  31. struct {
  32.     doublereal omega, time, delta, delold[7], ag[7], vt, xni, egfet, xmu, 
  33.         sfactr;
  34.     integer mode, modedc, icalc, initf, method, iord, maxord, noncon, iterno, 
  35.         itemno, nosolv, modac, ipiv, ivmflg, ipostp, iscrch, iofile;
  36. } status_;
  37.  
  38. #define status_1 status_
  39.  
  40. struct {
  41.     integer iprnta, iprntl, iprntm, iprntn, iprnto, limtim, limpts, lvlcod, 
  42.         lvltim, itl1, itl2, itl3, itl4, itl5, itl6, igoof, nogo, keof;
  43. } flags_;
  44.  
  45. #define flags_1 flags_
  46.  
  47. struct {
  48.     doublereal tcstar[2], tcstop[2], tcincr[2];
  49.     integer icvflg, itcelm[2], kssop, kinel, kidin, kovar, kidout;
  50. } dc_;
  51.  
  52. #define dc_1 dc_
  53.  
  54. struct {
  55.     doublereal value[200000];
  56. } blank_;
  57.  
  58. #define blank_1 blank_
  59.  
  60. /* Table of constant values */
  61.  
  62. static integer c__1 = 1;
  63. static integer c__3 = 3;
  64. static integer c__8 = 8;
  65. static integer c__5 = 5;
  66.  
  67. /*<       subroutine sstf >*/
  68. /* Subroutine */ int sstf_()
  69. {
  70.     /* Initialized data */
  71.  
  72.     static struct {
  73.     char e_1[8];
  74.     doublereal e_2;
  75.     } equiv_24 = { {'/', ' ', ' ', ' ', ' ', ' ', ' ', ' '}, 0. };
  76.  
  77. #define aslash (*(doublereal *)&equiv_24)
  78.  
  79.     static struct {
  80.     char e_1[8];
  81.     doublereal e_2;
  82.     } equiv_25 = { {' ', ' ', ' ', ' ', ' ', ' ', ' ', ' '}, 0. };
  83.  
  84. #define ablnk (*(doublereal *)&equiv_25)
  85.  
  86.  
  87.     /* Format strings */
  88.     static char fmt_231[] = "(////,\0020****     small-signal characteristic\
  89. s\002//,\0020\002,5x,5a8,\002 = \002,1pd10.3,/,\0020\002,5x,\002input resist\
  90. ance at \002,a8,12x,\002 = \002,d10.3,/,\0020\002,5x,\002output resistance a\
  91. t \002,2a8,a3,\002 = \002,d10.3)";
  92.  
  93.     /* System generated locals */
  94.     integer i_1;
  95.  
  96.     /* Builtin functions */
  97.     integer s_wsfe(), do_fio(), e_wsfe();
  98.  
  99.     /* Local variables */
  100.     static doublereal anam, save[3];
  101.     static integer locv;
  102.     extern /* Subroutine */ int move_();
  103.     static doublereal trfn;
  104.     static integer ipos;
  105.     static doublereal zout;
  106.     extern /* Subroutine */ int copy8_(), zero8_();
  107.     static integer i, j, k;
  108.     static doublereal creal;
  109.     extern /* Subroutine */ int dcsol_();
  110.     static integer iptri, iptro;
  111.     extern /* Subroutine */ int dcdcmp_();
  112. #define nodplc ((integer *)&blank_1)
  113. #define cvalue ((complex *)&blank_1)
  114.     static doublereal string[5];
  115.     static integer noposi, nonegi, noposo, nonego;
  116.     extern /* Subroutine */ int outnam_();
  117.     static doublereal zin;
  118.  
  119.     /* Fortran I/O blocks */
  120.     static cilist io__23 = { 0, 0, 0, fmt_231, 0 };
  121.  
  122.  
  123. /*<       implicit double precision (a-h,o-z) >*/
  124.  
  125. /*     this routine computes the value of the small-signal transfer */
  126. /* function specified by the user. */
  127.  
  128. /* spice version 2g.6  sccsid=tabinf 3/15/83 */
  129. /*<       common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem, >*/
  130. /*<      1   isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize, >*/
  131. /*<      2   junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr, >*/
  132. /*<      3   nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1, >*/
  133. /*<      4   lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd, >*/
  134. /*<      5   imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval, >*/
  135. /*<      6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt, >*/
  136. /*<      7   irowno,jcolno,nttbr,nttar,lvntmp >*/
  137. /* spice version 2g.6  sccsid=cirdat 3/15/83 */
  138. /*<       common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop, >*/
  139. /*<      1   nut,nlt,nxtrm,ndist,ntlin,ibr,numvs,numalt,numcyc >*/
  140. /* spice version 2g.6  sccsid=status 3/15/83 */
  141. /*<       common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet, >*/
  142. /*<      1   xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon, >*/
  143. /*<      2   iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile >*/
  144. /* spice version 2g.6  sccsid=flags 3/15/83 */
  145. /*<       common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts, >*/
  146. /*<      1   lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,itl6,igoof,nogo,keof >*/
  147. /* spice version 2g.6  sccsid=dc 3/15/83 */
  148. /*<       common /dc/ tcstar(2),tcstop(2),tcincr(2),icvflg,itcelm(2),kssop, >*/
  149. /*<      1   kinel,kidin,kovar,kidout >*/
  150. /* spice version 2g.6  sccsid=blank 3/15/83 */
  151. /*<       common /blank/ value(200000) >*/
  152. /*<       integer nodplc(64) >*/
  153. /*<       complex cvalue(32) >*/
  154. /*<       equivalence (value(1),nodplc(1),cvalue(1)) >*/
  155.  
  156.  
  157. /*<       dimension string(5),save(3) >*/
  158. /*<       data aslash, ablnk / 1h/, 1h  / >*/
  159.  
  160. /*  setup current vector for input resistance and transfer function */
  161.  
  162. /*<       call zero8(value(lvn+1),nstop) >*/
  163.     zero8_(&blank_1.value[tabinf_1.lvn], &cirdat_1.nstop);
  164. /*<       if (kidin.eq.10) go to 5 >*/
  165.     if (dc_1.kidin == 10) {
  166.     goto L5;
  167.     }
  168. /* ...  voltage source input */
  169. /*<       iptri=nodplc(kinel+6) >*/
  170.     iptri = nodplc[dc_1.kinel + 5];
  171. /*<       value(lvn+iptri)=+1.0d0 >*/
  172.     blank_1.value[tabinf_1.lvn + iptri - 1] = 1.;
  173. /*<       go to 20 >*/
  174.     goto L20;
  175. /* ...  current source input */
  176. /*<     5 noposi=nodplc(kinel+2) >*/
  177. L5:
  178.     noposi = nodplc[dc_1.kinel + 1];
  179. /*<       nonegi=nodplc(kinel+3) >*/
  180.     nonegi = nodplc[dc_1.kinel + 2];
  181. /*<       value(lvn+noposi)=-1.0d0 >*/
  182.     blank_1.value[tabinf_1.lvn + noposi - 1] = -1.;
  183. /*<       value(lvn+nonegi)=+1.0d0 >*/
  184.     blank_1.value[tabinf_1.lvn + nonegi - 1] = 1.;
  185.  
  186. /*  lu decompose and solve the system of circuit equations */
  187.  
  188. /* ...  reorder the right-hand side */
  189. /*<    20 call dcdcmp >*/
  190. L20:
  191.     dcdcmp_();
  192. /*<       call dcsol >*/
  193.     dcsol_();
  194. /*<       value(lvn+1)=0.0d0 >*/
  195.     blank_1.value[tabinf_1.lvn] = 0.;
  196. /*<       do 25 i=1,nstop >*/
  197.     i_1 = cirdat_1.nstop;
  198.     for (i = 1; i <= i_1; ++i) {
  199. /*<       j=nodplc(icswpr+i) >*/
  200.     j = nodplc[tabinf_1.icswpr + i - 1];
  201. /*<       k=nodplc(irswpf+j) >*/
  202.     k = nodplc[tabinf_1.irswpf + j - 1];
  203. /*<       value(lvntmp+i)=value(lvn+k) >*/
  204.     blank_1.value[tabinf_1.lvntmp + i - 1] = blank_1.value[tabinf_1.lvn + 
  205.         k - 1];
  206. /*<    25 continue >*/
  207. /* L25: */
  208.     }
  209. /*<       call copy8(value(lvntmp+1),value(lvn+1),nstop) >*/
  210.     copy8_(&blank_1.value[tabinf_1.lvntmp], &blank_1.value[tabinf_1.lvn], &
  211.         cirdat_1.nstop);
  212.  
  213. /*  evaluate transfer function */
  214.  
  215. /*<       if (nodplc(kovar+5).ne.0) go to 30 >*/
  216.     if (nodplc[dc_1.kovar + 4] != 0) {
  217.     goto L30;
  218.     }
  219. /* ...  voltage output */
  220. /*<       noposo=nodplc(kovar+2) >*/
  221.     noposo = nodplc[dc_1.kovar + 1];
  222. /*<       nonego=nodplc(kovar+3) >*/
  223.     nonego = nodplc[dc_1.kovar + 2];
  224. /*<       trfn=value(lvn+noposo)-value(lvn+nonego) >*/
  225.     trfn = blank_1.value[tabinf_1.lvn + noposo - 1] - blank_1.value[
  226.         tabinf_1.lvn + nonego - 1];
  227. /*<       go to 40 >*/
  228.     goto L40;
  229. /* ...  current output (through voltage source) */
  230. /*<    30 iptro=nodplc(kovar+2) >*/
  231. L30:
  232.     iptro = nodplc[dc_1.kovar + 1];
  233. /*<       iptro=nodplc(iptro+6) >*/
  234.     iptro = nodplc[iptro + 5];
  235. /*<       trfn=value(lvn+iptro) >*/
  236.     trfn = blank_1.value[tabinf_1.lvn + iptro - 1];
  237.  
  238. /*  evaluate input resistance */
  239.  
  240. /*<    40 if (kidin.eq.9) go to 50 >*/
  241. L40:
  242.     if (dc_1.kidin == 9) {
  243.     goto L50;
  244.     }
  245. /* ...  current source input */
  246. /*<       zin=value(lvn+nonegi)-value(lvn+noposi) >*/
  247.     zin = blank_1.value[tabinf_1.lvn + nonegi - 1] - blank_1.value[
  248.         tabinf_1.lvn + noposi - 1];
  249. /*<       go to 70 >*/
  250.     goto L70;
  251. /* ...  voltage source input */
  252. /*<    50 creal=value(lvn+iptri) >*/
  253. L50:
  254.     creal = blank_1.value[tabinf_1.lvn + iptri - 1];
  255. /*<       if (dabs(creal).ge.1.0d-20) go to 60 >*/
  256.     if (abs(creal) >= 1e-20) {
  257.     goto L60;
  258.     }
  259. /*<       zin=1.0d20 >*/
  260.     zin = 1e20;
  261. /*<       go to 70 >*/
  262.     goto L70;
  263. /*<    60 zin=-1.0d0/creal >*/
  264. L60:
  265.     zin = -1. / creal;
  266.  
  267. /*  setup current vector for output resistance */
  268.  
  269. /*<    70 call zero8(value(lvn+1),nstop) >*/
  270. L70:
  271.     zero8_(&blank_1.value[tabinf_1.lvn], &cirdat_1.nstop);
  272. /*<       if (nodplc(kovar+5).ne.0) go to 80 >*/
  273.     if (nodplc[dc_1.kovar + 4] != 0) {
  274.     goto L80;
  275.     }
  276. /* ...  voltage output */
  277. /*<       value(lvn+noposo)=-1.0d0 >*/
  278.     blank_1.value[tabinf_1.lvn + noposo - 1] = -1.;
  279. /*<       value(lvn+nonego)=+1.0d0 >*/
  280.     blank_1.value[tabinf_1.lvn + nonego - 1] = 1.;
  281. /*<       go to 90 >*/
  282.     goto L90;
  283. /*<    80 if (nodplc(kovar+2).ne.kinel) go to 85 >*/
  284. L80:
  285.     if (nodplc[dc_1.kovar + 1] != dc_1.kinel) {
  286.     goto L85;
  287.     }
  288. /*<       zout=zin >*/
  289.     zout = zin;
  290. /*<       go to 200 >*/
  291.     goto L200;
  292. /* ...  current output (through voltage source) */
  293. /*<    85 value(lvn+iptro)=+1.0d0 >*/
  294. L85:
  295.     blank_1.value[tabinf_1.lvn + iptro - 1] = 1.;
  296.  
  297. /*  perform new forward and backward substitution */
  298.  
  299. /* ...  reorder the right-hand side */
  300. /*<    90 call dcsol >*/
  301. L90:
  302.     dcsol_();
  303. /*<       value(lvn+1)=0.0d0 >*/
  304.     blank_1.value[tabinf_1.lvn] = 0.;
  305. /*<       do 95 i=1,nstop >*/
  306.     i_1 = cirdat_1.nstop;
  307.     for (i = 1; i <= i_1; ++i) {
  308. /*<       j=nodplc(icswpr+i) >*/
  309.     j = nodplc[tabinf_1.icswpr + i - 1];
  310. /*<       k=nodplc(irswpf+j) >*/
  311.     k = nodplc[tabinf_1.irswpf + j - 1];
  312. /*<       value(lvntmp+i)=value(lvn+k) >*/
  313.     blank_1.value[tabinf_1.lvntmp + i - 1] = blank_1.value[tabinf_1.lvn + 
  314.         k - 1];
  315. /*<    95 continue >*/
  316. /* L95: */
  317.     }
  318. /*<       call copy8(value(lvntmp+1),value(lvn+1),nstop) >*/
  319.     copy8_(&blank_1.value[tabinf_1.lvntmp], &blank_1.value[tabinf_1.lvn], &
  320.         cirdat_1.nstop);
  321.  
  322. /*  evaluate output resistance */
  323.  
  324. /*<   100 if (nodplc(kovar+5).ne.0) go to 110 >*/
  325. /* L100: */
  326.     if (nodplc[dc_1.kovar + 4] != 0) {
  327.     goto L110;
  328.     }
  329. /* ...  voltage output */
  330. /*<       zout=value(lvn+nonego)-value(lvn+noposo) >*/
  331.     zout = blank_1.value[tabinf_1.lvn + nonego - 1] - blank_1.value[
  332.         tabinf_1.lvn + noposo - 1];
  333. /*<       go to 200 >*/
  334.     goto L200;
  335. /* ...  current output (through voltage source) */
  336. /*<   110 creal=value(lvn+iptro) >*/
  337. L110:
  338.     creal = blank_1.value[tabinf_1.lvn + iptro - 1];
  339. /*<       if (dabs(creal).ge.1.0d-20) go to 120 >*/
  340.     if (abs(creal) >= 1e-20) {
  341.     goto L120;
  342.     }
  343. /*<       zout=1.0d20 >*/
  344.     zout = 1e20;
  345. /*<       go to 200 >*/
  346.     goto L200;
  347. /*<   120 zout=-1.0d0/creal >*/
  348. L120:
  349.     zout = -1. / creal;
  350.  
  351. /*  print results */
  352.  
  353. /*<   200 do 210 i=1,5 >*/
  354. L200:
  355.     for (i = 1; i <= 5; ++i) {
  356. /*<       string(i)=ablnk >*/
  357.     string[i - 1] = ablnk;
  358. /*<   210 continue >*/
  359. /* L210: */
  360.     }
  361. /*<       ipos=1 >*/
  362.     ipos = 1;
  363. /*<       call outnam(kovar,1,string,ipos) >*/
  364.     outnam_(&dc_1.kovar, &c__1, string, &ipos);
  365. /*<       call copy8(string,save,3) >*/
  366.     copy8_(string, save, &c__3);
  367. /*<       call move(string,ipos,aslash,1,1) >*/
  368.     move_(string, &ipos, &aslash, &c__1, &c__1);
  369. /*<       ipos=ipos+1 >*/
  370.     ++ipos;
  371. /*<       locv=nodplc(kinel+1) >*/
  372.     locv = nodplc[dc_1.kinel];
  373. /*<       anam=value(locv) >*/
  374.     anam = blank_1.value[locv - 1];
  375. /*<       call move(string,ipos,anam,1,8) >*/
  376.     move_(string, &ipos, &anam, &c__1, &c__8);
  377. /*<       write (iofile,231) string,trfn,anam,zin,save,zout >*/
  378.     io__23.ciunit = status_1.iofile;
  379.     s_wsfe(&io__23);
  380.     do_fio(&c__5, (char *)&string[0], (ftnlen)sizeof(doublereal));
  381.     do_fio(&c__1, (char *)&trfn, (ftnlen)sizeof(doublereal));
  382.     do_fio(&c__1, (char *)&anam, (ftnlen)sizeof(doublereal));
  383.     do_fio(&c__1, (char *)&zin, (ftnlen)sizeof(doublereal));
  384.     do_fio(&c__3, (char *)&save[0], (ftnlen)sizeof(doublereal));
  385.     do_fio(&c__1, (char *)&zout, (ftnlen)sizeof(doublereal));
  386.     e_wsfe();
  387. /*<   231 format(////,'0****     small-signal characteristics'//, >*/
  388. /*<      1   1h0,5x,5a8,3h = ,1pd10.3,/, >*/
  389. /*<      2   1h0,5x,'input resistance at ',a8,12x,3h = ,d10.3,/, >*/
  390. /*<      3   1h0,5x,'output resistance at ',2a8,a3,3h = ,d10.3) >*/
  391. /*<       return >*/
  392.     return 0;
  393. /*<       end >*/
  394. } /* sstf_ */
  395.  
  396. #undef cvalue
  397. #undef nodplc
  398. #undef ablnk
  399. #undef aslash
  400.  
  401.  
  402.